home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / comm / tcp / AbDial.lha / abdial.rexx < prev    next >
OS/2 REXX Batch file  |  1996-12-06  |  15KB  |  746 lines

  1. /* ABCS dialup V1.25 */
  2.  
  3. options RESULTS
  4. options FAILAT 25
  5.  
  6. /* MAIN */
  7.  
  8. MainInit()
  9.  
  10. ScriptName = arg(1)
  11.  
  12. Signal on break_c
  13.  
  14. if (show('p','ABDIALHOST')~=0) then AbCloseWindow()
  15.  
  16. AbOpenWindow()
  17.  
  18. AbSetState("OPEN")
  19.  
  20. result=open('scriptfh',ScriptName,'R')
  21. if (result==0) then AbExit('Could not open script '||scriptname,25)
  22.  
  23. ok=1
  24. do while (eof('scriptfh')==0)
  25.   line=readln('scriptfh')
  26.   comm=upper(word(line,1))
  27.   if (comm=='//') then NOP
  28.   if (comm=='SERBAUD') then AbSerBaud(AbWords(line,2,60))
  29.   if (comm=='SERDEV')  then AbSerDev(AbWords(line,2,60))
  30.   if (comm=='SEROPT')  then AbSerOpt(AbWords(line,2,60))
  31.   if (comm=='INIT')    then AbInit(AbWords(line,2,60))
  32.   if (comm=='FLUSH')   then AbFlush(AbWords(line,2,60))
  33.   if (comm=='DIAL')    then AbDial(AbWords(line,2,1),AbWords(line,3,60))
  34.   if (comm=='DELAY')   then AbDelay(AbWords(line,2,60))
  35.   if (comm=='WAIT')    then AbWait(AbWords(line,2,1),AbWords(line,3,60))
  36.   if (comm=='GETIP')   then AbGetIP(AbWords(line,2,1),AbWords(line,3,60))
  37.   if (comm=='SEND')    then AbSend(AbWords(line,2,60))
  38.   if (comm=='SEND2')   then AbSend2(AbWords(line,2,60))
  39.   if (comm=='HANGUP')  then AbHangup(AbWords(line,2,60))
  40. end
  41. AbExit("",0)
  42.  
  43. /******************************************************************************/
  44. /* script functions                                                           */
  45. /******************************************************************************/
  46.  
  47. AbInit:
  48.     AbFlush()
  49.     s2=arg(1)
  50.     AbSetState("INIT")
  51.     AbSerWriteln(s2)
  52.     i=ABCS_WaitStr("OK",10,1)
  53.     if (i~=0) then AbSetResult("OK")
  54. return 0
  55.  
  56.  
  57.  
  58. AbFlush:
  59.     SerData=""
  60. return 0
  61.  
  62.  
  63.  
  64. AbDial:
  65.     Provider  = arg(1)
  66.     Number    = arg(2)
  67.     Connected = 0
  68.     Status    = 0
  69.  
  70.     DialMode = 1
  71.     AbSetTimer(0,60)
  72.     do forever
  73.         if (Status == 0) then
  74.         do
  75.             AbSetState("DIAL "||Provider)
  76.             AbSerWriteln(dialstr||number)
  77.             String = ''
  78.             Status = 25
  79.             Count  = 0
  80.         end
  81.  
  82.         ABCSDelay(50)
  83.         AbSetTimer(count,60)
  84.  
  85.         String=String||AbSerRead()
  86.  
  87.         if (status ~= 0) then
  88.           do
  89.             status = TestString(String)
  90.           end
  91.  
  92.         if (status == 601) then leave
  93.  
  94.         if (status == 602) then
  95.           do
  96.             status = 0
  97.             AbSetResult("BUSY")
  98.           end
  99.  
  100.         if (status == 603) then
  101.           do
  102.             status = 0
  103.             AbSetResult("NO CARRIER")
  104.           end
  105.  
  106.         if (status == 604) then
  107.           do
  108.             status = 0
  109.             AbSetResult("NO DIALTONE")
  110.           end
  111.  
  112.         if (count == 60) then
  113.           do
  114.             status = 0
  115.             AbSetResult("MODEM NOT RESPONDING")
  116.           end
  117.  
  118.         count = count + 1
  119.     end
  120.     DialMode = 0
  121.  
  122.     connect = 1
  123.     parse var String .'CONNECT ' speed+5 +2 String
  124.     AbSetResult('CONNECT '||speed)
  125. return 0
  126.  
  127.  
  128.  
  129. AbDelay:
  130.     delayvalue=arg(1)
  131.     if ((verify(delayvalue,"0123456789")~=0) | (delayvalue=="")) then delayvalue=1
  132.     AbSetState("DELAY")
  133.     AbShowDelay(delayvalue*50)
  134.     AbSetResult("")
  135. return 0
  136.  
  137.  
  138.  
  139. AbSend:
  140.     senddata=arg(1)
  141.     AbSerWriteln(senddata)
  142. return 0
  143.  
  144.  
  145.  
  146. AbSend2:
  147.     senddata=arg(1)
  148.     AbSerWrite(senddata)
  149. return 0
  150.  
  151.  
  152.  
  153. AbWait:
  154.     t=arg(1)
  155.     s=arg(2)
  156.     if (verify(t,"0123456789")~=0) then
  157.     do
  158.       if (s~="") then s=" "||s
  159.       s=t||s
  160.       t=25
  161.     end
  162.     ABCS_Waitstr(s,t,0)
  163. return 0
  164.  
  165.  
  166.  
  167. AbGetIP:
  168.     var=arg(1)
  169.     s=arg(2)
  170.  
  171.     if (var=="") then var="AbcsIP"
  172.     if (s=="") then s="address"
  173.  
  174.     i=1
  175.     pos=1
  176.     found=0
  177.     do while (i<length(SerData))
  178.       if (substr(SerData,i,length(s))==s) then
  179.       do
  180.         pos=i+length(s)
  181.         found=1
  182.       end
  183.       i=i+1
  184.     end
  185.  
  186.     do while ((substr(SerData,pos,1)==" ") & (pos<length(SerData)))
  187.       pos=pos+1
  188.     end
  189.  
  190.     string=substr(SerData,pos,length(SerData)-pos+1)
  191.  
  192.     parse var string a '.' b '.' c '.' d '.' .
  193.     slip_ip = a||'.'||b||'.'||c||'.'||AbcsStripCr(d)
  194.     slip_ip = AbcsStripCr(slip_ip)
  195.  
  196.     AbSetResult(slip_ip)
  197.  
  198.     address command
  199.     'setenv '||var||' "'||slip_ip||'"'
  200. return 0
  201.  
  202.  
  203.  
  204. AbSerBaud:
  205.     i=arg(1)
  206.     if ((verify(i,"0123456789")~=0) | (i=="")) then i=SerialBaud
  207.     SerialBaud=i
  208. return 0
  209.  
  210.  
  211.  
  212. AbSerDev:
  213.     s=arg(1)
  214.     if (length(s)==0) then s=SerialDevice
  215.     SerialDevice=s
  216. return 0
  217.  
  218.  
  219.  
  220. AbSerOpt:
  221.     s=arg(1)
  222.     if (length(s)~=3) then s=SerialOpts
  223.     SerialOpts=s
  224. return 0
  225.  
  226.  
  227. AbHangUp:
  228.     state=0
  229.     count=0
  230.     AbSetState("HANGUP LINE")
  231.     do while ((state~=25) & (count<25))
  232.       if (state<3) then
  233.       do
  234.         ABCSDelay(50)
  235.         if (state==0) then
  236.         do
  237.           AbSerWriteln('at')
  238.           result=ABCS_Waitstr('OK',2,2)
  239.           state=1
  240.           if (result~=0) then state=3
  241.         end
  242.         else
  243.         do
  244.           Delay(10)
  245.           AbSerWrite('+')
  246.           Delay(10)
  247.           AbSerWrite('+')
  248.           Delay(10)
  249.           AbSerWrite('+')
  250.           result=ABCS_Waitstr('OK',3,2)
  251.           state=state+1
  252.         end
  253.       end
  254.       else
  255.       do
  256.         AbSerWriteln('ATH0')
  257.         result=ABCS_Waitstr('OK',5,2)
  258.         if (result~=0) then state=25
  259.                        else state=0
  260.       end
  261.  
  262.       count=count+1
  263.       if (state==1) then AbSetResult('DATA MODE')
  264.       if (state==2) then AbSetResult('COMMAND MODE')
  265.       if (state==25) then AbSetResult('OK')
  266.       if (count==25) then AbSetResult('FAIL')
  267.     end
  268. return 0
  269.  
  270.  
  271.  
  272. /******************************************************************************/
  273. /* support functions                                                          */
  274. /******************************************************************************/
  275.  
  276. MainInit:
  277.     'scriptfh'   = 0
  278.     cr           = '0d'x
  279.     crlf         = d2c(13)||d2c(10)
  280.     lf           = d2c(10)
  281.     SerialDevice = 'serial.device'
  282.     SerialBaud   = 57600
  283.     SerialOpts   = '8N1'
  284.     scriptname   = 'abcs.scr'
  285.     dialstr      = 'atdt'
  286.     buffer       = 0
  287.     SerData      = ""
  288.     connected    = 0
  289.     GuiOpen      = 0
  290.     DialMode     = 0
  291.     serh         = 0
  292.     AbErrorMode  = 25
  293.     if ~open('stdout','*') then Exit(25)
  294.     if ~show('L',"rexxsupport.library") then
  295.     if ~addlib('rexxsupport.library', 0, -30, 0) then AbExit('Could not open rexxsupport.library',25)
  296.     if ~show('L', "rexxserdev.library") then
  297.     if ~addlib( 'rexxserdev.library', 0, -30, 0) then AbExit('Could not open rexxserdev.library',25)
  298.     SerBufC   = AllocMem(6000)
  299.     if (SerBufC == 0) then AbExit("Could not alloc memory",27)
  300.     SerBuf    = c2d(SerBufC)
  301. return 0
  302.  
  303.  
  304. AbWords:
  305.     str=arg(1)
  306.     pos=arg(2)
  307.     nr =arg(3)
  308.  
  309.     i=1
  310.     dir=1
  311.     num=1
  312.     res=""
  313.     quote=0
  314.     skip=0
  315.     do while (i<=length(str))
  316.       cl=c
  317.       c=substr(str,i,1)
  318.       if ((c=='\') & (dir==1)) then dir=0
  319.       else
  320.       do
  321.         if (dir==0) then dir=1
  322.         else
  323.         do
  324.           if (c=='"') then
  325.           do
  326.             quote=1-quote
  327.             skip=1
  328.           end
  329.           if ((c==' ') & (quote==0)) then
  330.           do
  331.             num=num+1
  332.             if (num==pos) then skip=1
  333.           end
  334.         end
  335.       end
  336.       if ((num>=pos) & (num<=pos+nr-1) & (skip==0)) then res=res||c
  337.       skip=0
  338.       i=i+1
  339.     end
  340.  
  341.     res=AbConv(res)
  342. return res
  343.  
  344.  
  345. AbConv:
  346.     s=arg(1)
  347.     r=""
  348.     i=1
  349.     mode=0
  350.     do while (i<=length(s))
  351.       c=substr(s,i,1)
  352.       if (mode==1) then
  353.       do
  354.         if (substr(s,i,1)=='n') then r=r||crlf
  355.         else if (substr(s,i,1)=='r') then r=r||cr
  356.              else if (substr(s,i,1)=='l') then r=r||lf
  357.                   else r=r||c
  358.         mode=0
  359.       end
  360.       else
  361.       do
  362.         if (c=='\') then mode=1
  363.         else r=r||c
  364.       end
  365.       i=i+1
  366.     end
  367. return r
  368.  
  369.  
  370.  
  371. AbSerWrite:
  372.     s=arg(1)
  373.     AbSerOpen()
  374.     if (serh~=0) then
  375.     do
  376.         SerWrite(serh, s, length(s))
  377.     end
  378. return 0
  379.  
  380.  
  381.  
  382. AbSerWriteln:
  383.     s=arg(1)
  384.     AbSerOpen()
  385.     AbSerWrite(s||crlf)
  386. return 0
  387.  
  388.  
  389.  
  390. AbSerRead:
  391.     s=""
  392.     AbSerOpen()
  393.     if (serh~=0) then
  394.     do
  395.         stat = SerQuery(serh)
  396.         parse upper var stat valid rbytes .
  397.         s=SerRead(serh, SerBuf, rbytes)
  398.     end
  399.     SerData=SerData||s
  400. return s
  401.  
  402.  
  403.  
  404. break_c:
  405.     Signal off break_c
  406.     AbExit('DIALUP ABORTED',60)
  407. return 0
  408.  
  409.  
  410.  
  411. ReDial:
  412.     if (DialMode==1) then
  413.     do
  414.         AbSerWriteln('')
  415.         ABCSDelay(50)
  416.         Status=0
  417.     end
  418. Return 0
  419.  
  420.  
  421.  
  422. AbCleanup:
  423.     if (serh~=0) then AbSerWriteln('')
  424.     if connected ~= 0 then
  425.         do
  426.             AbHangUp()
  427.         end
  428.     AbSerClose()
  429.     if (SerBufC~=0) then FreeMem(SerBufC,4096)
  430.     AbCloseWindow()
  431. return 0
  432.  
  433.  
  434.  
  435. AbExit:
  436.     txt=arg(1)
  437.     code=arg(2)
  438.     if (txt~="") then ABWriteln(txt)
  439.     AbCleanup()
  440.     exit code
  441. return 0
  442.  
  443.  
  444.  
  445. ABCS_WaitStr:
  446.     teststr = arg(1)
  447.     timeout = arg(2)
  448.     quiet = arg(3)
  449.     check = 0
  450.     initlength = length(SerData)
  451.     if (quiet==0) then AbSetState('WAIT : '||teststr)
  452.     i=0
  453.     AbSetTimer(i,timeout)
  454.     do until ((check ~= 0) | (i>=timeout))
  455.         s=AbSerRead()
  456.         check    = pos(teststr,SerData)
  457.         ABCSDelay(25)
  458.         s=AbSerRead()
  459.         i=i+1
  460.         AbSetTimer(i,timeout)
  461.     end
  462.     if ((check == 0) & (quiet~=2)) then
  463.       do
  464.         AbSetResult("TIMEOUT")
  465.         ABWriteError('UNEXPECTED DATA : '||crlf||substr(SerData,initlength+1,length(SerData)-initlength))
  466.       end
  467.     else if (quiet==0) then AbSetResult("OK")
  468. return check
  469.  
  470.  
  471. TestString:
  472.     teststr = arg(1)
  473.     if (pos('CONNECT'   , teststr) ~= 0) then return 601
  474.     if (pos('BUSY'      , teststr) ~= 0) then return 602
  475.     if (pos('NO CARRIER', teststr) ~= 0) then return 603
  476.     if (pos('NO DIALTONE', teststr) ~= 0) then return 604
  477. return 25
  478.  
  479.  
  480.  
  481. ABCSDelay:
  482.     len = arg(1)
  483.     Delay(len)
  484.     AbCheckMessages()
  485. Return 0
  486.  
  487.  
  488. AbShowDelay:
  489.     delaylen = arg(1)
  490.     i=0
  491.     do while (i<=delaylen)
  492.       AbSetTimer(i,delaylen)
  493.       i=i+25
  494.       ABCSDelay(10)
  495.     end
  496. return 0
  497.  
  498.  
  499. AbWriteError:
  500.     errorstr = arg(1)
  501.  
  502.     nstr = ''
  503.     errorlc = ''
  504.     do errorpos = 1 to length(errorstr)
  505.       errorc = substr(errorstr,errorpos,1)
  506.       if ((errorlc == lf) & (errorc = lf)) then errorc = ''
  507.       if (errorc == cr) then errorc = lf
  508.  
  509.       nstr = nstr || errorc
  510.       errorlc = errorc
  511.     end
  512.  
  513.     if Open('ABCS','CON:0/25//105/ABCS TCP-IP DIALUP V1.0/CLOSE/WAIT','WRITE') then
  514.     do
  515.       writeln('ABCS',nstr)
  516.       Delay(25)
  517.       Close('ABCS')
  518.     end
  519. Return 0
  520.  
  521.  
  522.  
  523. AbcsStripCr:
  524.     str = arg(1)
  525.     s = ''
  526.     i = 1
  527.     ok = 1
  528.     do while (i<=length(str)) & (ok == 1)
  529.       c1 = substr(str,i,1)
  530.       if ((c1 == cr) | (c1 == lf)) then ok=0
  531.                                    else s = s||c1
  532.       i=i+1
  533.     end
  534. return s
  535.  
  536.  
  537.  
  538. ABWrite:
  539.     s = arg(1)
  540.     writech('stdout',s)
  541. return 0
  542.  
  543.  
  544.  
  545. ABWriteln:
  546.     s = arg(1)||lf
  547.     writech('stdout',s)
  548. return 0
  549.  
  550.  
  551. AbSerOpen:
  552.     if (serh==0) then
  553.     do
  554.         AbErrorMode=60
  555.         serh      = SerOpen(SerialDevice, 0)
  556.         AbcsDelay(250)
  557.         if (serh == 0) then failure()
  558.         AbErrorMode=25
  559.         SerClear(serh)
  560.         SerSetParms(serh, SerialBaud, substr(SerialOpts,1,1), substr(SerialOpts,2,1), substr(SerialOpts,3,1), 0, 25000, 4096)
  561.     end
  562. return 0
  563.  
  564.  
  565.  
  566. AbSerClose:
  567.     if (serh~=0) then
  568.     do
  569.         SerClose(serh)
  570.         serh=0
  571.     end
  572. return 0
  573.  
  574.  
  575.  
  576. /******************************************************************************/
  577. /* gui functions                                                              */
  578. /******************************************************************************/
  579.  
  580. AbOpenWindow:
  581.  
  582.     if ~show('l', "rexxarplib.library") then
  583.     if ~addlib('rexxarplib.library',0,-30,0) then AbExit('Could not open rexxarplib.library',25)
  584.  
  585.     if ~show('l', "rexxsupport.library") then
  586.     if ~addlib('rexxsupport.library',0,-30,0) then AbExit('Could not open rexxsupport.library',25)
  587.  
  588.     drop AbDialPort
  589.     Call OPENPORT(AbDialPort)
  590.  
  591.     drop AbDialHost
  592.     ADDRESS COMMAND 'Run >nil:' 'SYS:Rexxc/rx ''Call createhost(AbDialHost, AbDialPort,)'''
  593.  
  594.     ok='0'
  595.     i=25
  596.     do while (ok=='0')
  597.       ok=show('p','ABDIALHOST')
  598.       Call delay(10)
  599.       i=i-1
  600.       if (i==0) then
  601.       do
  602.         AbDialHost=0
  603.         AbExit("Unable to create host",28)
  604.       end
  605.     end
  606.  
  607.     idcmp = 'CLOSEWINDOW+GADGETUP'
  608.     flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH'
  609.     posx = ScreenCols('Workbench')-325
  610.     posy = ScreenRows('Workbench')-125
  611.     posx = trunc(posx/2)
  612.     posy = trunc(posy/2)
  613.     result = OpenWindow(AbDialHost, posx, posy, 325, 125, idcmp, flags, "ABCS DIALUP V1.25 (C) ABCS 1996")
  614.     if (result==0) then AbExit("Unable to open window",29)
  615.  
  616.     call SetAPen(AbDialHost,1)
  617.     result = SetFont(AbDialHost, 'topaz.font', 8,0,2,8)
  618.  
  619.     call AddGadget(AbDialHost, 20, 23, 00, " ABCS DIALUP V1.25                 ", "ABCS")
  620.  
  621.     call Move(AbDialHost,25,53)
  622.     call Text(AbDialHost,"STATE  : ")
  623.     call Move(AbDialHost,25,68)
  624.     call Text(AbDialHost,"RESULT : ")
  625.     call Move(AbDialHost,25,83)
  626.     call Text(AbDialHost,"TIME   : ")
  627.  
  628.     call AbDrawBox(96,75,305,86)
  629.  
  630.     call AddGadget(AbDialHost, 20, 98, 01, "     REDIAL     ","REDIAL")
  631.     call AddGadget(AbDialHost, 172, 98, 02, "     ABORT      ","ABORT")
  632.     GuiOpen = 1
  633. RETURN 0
  634.  
  635.  
  636. AbCloseWindow:
  637.     if (AbDialHost~=0) then call Exit(AbDialHost)
  638.     if (AbDialPort~=0) then call ClosePort(AbDialPort)
  639. return 0
  640.  
  641.  
  642. AbDrawBox:
  643.     x = arg(1)
  644.     y = arg(2)
  645.     x2= arg(3)
  646.     y2= arg(4)
  647.     call SetAPen(AbDialHost,1)
  648.     Move(AbDialHost,x,y2-1)
  649.     Draw(AbDialHost,x,y)
  650.     Draw(AbDialHost,x2-1,y)
  651.     call SetAPen(AbDialHost,2)
  652.     Move(AbDialHost,x2,y+1)
  653.     Draw(AbDialHost,x2,y2)
  654.     Draw(AbDialHost,x+1,y2)
  655.     call SetAPen(AbDialHost,1)
  656. return 0
  657.  
  658.  
  659. AbCheckMessages:
  660.     CheckOk=1
  661.     R=1
  662.     do while (CheckOk==1)
  663.         p=GETPKT(AbDialPort)
  664.         if (p='0000 0000'x) then
  665.         do
  666.             CheckOk=0
  667.         end
  668.         else
  669.         do
  670.             command=GETARG(p)
  671.             t=REPLY(p,0)
  672.             PARSE VAR command arg1' 'arg2' 'arg3' 'arg4' '
  673.             if ((arg1=='CLOSEWINDOW') | (arg1=="ABORT")) THEN
  674.             do
  675.               AbSetState("ABORT")
  676.               AbSetResult("")
  677.               AbExit("",60)
  678.             end
  679.             if (arg1=="REDIAL") THEN
  680.             do
  681.               Redial()
  682.             end
  683.             if (arg1=="ABCS") THEN
  684.             do
  685.               AbcsMessage()
  686.             end
  687.         end
  688.    end
  689. return r
  690.  
  691.  
  692. AbSetTimer:
  693.     pos=arg(1)
  694.     max=arg(2)
  695.     if (max<1) then max=1
  696.     if (pos>max) then pos=max
  697.     x1=97
  698.     y1=76
  699.     x2=x1+((304-97)*pos)/max
  700.     y2=85
  701.     x3=304
  702.  
  703.     call SetAPen(AbDialHost,3)
  704.     call RectFill(AbDialHost,x1,y1,x2,y2)
  705.     call SetAPen(AbDialHost,0)
  706.     if (x2<x3) THEN call RectFill(AbDialHost,x2+1,y1,x3,y2)
  707.     call SetAPen(AbDialHost,1)
  708. return 0
  709.  
  710.  
  711.  
  712. AbSetState:
  713.     s=arg(1)
  714.     s=substr(s,1,25," ")
  715.     call SetAPen(AbDialHost,1)
  716.     call Move(AbDialHost,96,53)
  717.     call Text(AbDialHost,s)
  718. return 0
  719.  
  720.  
  721.  
  722. AbSetResult:
  723.     s=arg(1)
  724.     s=substr(s,1,25," ")
  725.     call SetAPen(AbDialHost,1)
  726.     call Move(AbDialHost,96,68)
  727.     call Text(AbDialHost,s)
  728. return 0
  729.  
  730.  
  731. AbcsMessage:
  732.     abtxt=""
  733.     abtxt=abtxt||crlf
  734.     abtxt=abtxt||"ABCS DIALUP V1.25"||crlf
  735.     abtxt=abtxt||"(C) ABCS 1996"||crlf
  736.     abtxt=abtxt||crlf
  737.     abtxt=abtxt||"THIS PROGRAM MAY BE SPREAD/COPIED/USED"||crlf
  738.     abtxt=abtxt||"UNDER THE FOLLOWING RESTRICTIONS :"||crlf
  739.     abtxt=abtxt||crlf
  740.     abtxt=abtxt||"YOU DO NOT CHANGE ANYTHING IN IT AND DO"||crlf
  741.     abtxt=abtxt||"NOT CHARGE ANYTHING FOR COPYING THIS PROGRAM."||crlf
  742.     AbWriteError(abtxt)
  743. return 0
  744.  
  745.  
  746.